home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / golf / golf.bas < prev    next >
BASIC Source File  |  1995-04-02  |  6KB  |  194 lines
  1. Option Explicit
  2. '------------------------------------------------------------
  3. ' Global constants, data types, and function calls used by
  4. ' the GOLF.MAK project.
  5. '------------------------------------------------------------
  6.  
  7. ' ScaleMode constants
  8. Global Const TWIPS = 1
  9. Global Const PIXELS = 3
  10.  
  11. ' MsgBox constants
  12. Global Const MB_OK = 0                 ' OK button
  13. Global Const MB_ICONSTOP = 16          ' Critical message
  14. Global Const MB_ICONQUESTION = 32      ' Warning query
  15. Global Const MB_ICONEXCLAMATION = 48   ' Warning message
  16. Global Const MB_ICONINFORMATION = 64   ' Information message
  17.  
  18. ' RGB color constants
  19. Global Const BLUE = &HFF0000
  20. Global Const DK_BLUE = &H800000
  21. Global Const WHITE = &HFFFFFF
  22. Global Const RED = &HFF&
  23. Global Const BLACK = &H0&
  24. Global Const CYAN = &HFFFF00
  25. Global Const DK_CYAN = &H808000
  26. Global Const YELLOW = &HFFFF&
  27. Global Const BROWN = &H8080&
  28. Global Const GREEN = &HFF00&
  29. Global Const DK_GREEN = &H8000&
  30. Global Const MAGENTA = &HFF00FF
  31.  
  32. ' Data type defining an x-y coordinate.
  33. Type tLocation
  34.     X As Integer
  35.     Y As Integer
  36. End Type
  37.  
  38. ' Data type defining information related to
  39. ' a particular golf hole.
  40. Type tHole
  41.     FileName As String * 12
  42.     Tee As tLocation
  43.     Par As Integer
  44.     Tips As String
  45. End Type
  46.  
  47. ' The location of the program.
  48. Global AppPath As String
  49.  
  50. ' Constants for 3D Borders
  51. Global Const BORDER_INSET = 0
  52. Global Const BORDER_RAISED = 1
  53.  
  54. ' Functions and constants used to play sounds.
  55. Global Const SND_SYNC = &H0        ' Return when sound ends (the default)
  56. Global Const SND_ASYNC = &H1       ' Return as soon as sound starts
  57. Declare Function sndPlaySound Lib "MMSystem" (ByVal lpsound As String, ByVal FLAG As Integer) As Integer
  58.  
  59. ' Function that returns the color at a particular
  60. ' x-y location.
  61. Declare Function GetPixel Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Long
  62.  
  63. ' Constant and function used to quickly copy bitmaps.
  64. Global Const SRCCOPY = &HCC0020
  65. Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal NWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal XSrc As Integer, ByVal YSrc As Integer, ByVal dwRop As Long) As Integer
  66.  
  67. Sub CenterForm (AForm As Form)
  68. '------------------------------------------------------------
  69. ' Center a form on the screen.
  70. '------------------------------------------------------------
  71.  
  72.     AForm.Move (Screen.Width - AForm.Width) \ 2, (Screen.Height - AForm.Height) \ 2
  73. End Sub
  74.  
  75. Function GetDistance (Ax As Integer, Ay As Integer, Bx As Integer, By As Integer) As Single
  76. '------------------------------------------------------------
  77. ' Return the straight-line distance between two x-y points.
  78. '------------------------------------------------------------
  79.     
  80.     GetDistance = Abs(Sqr((Ax - Bx) ^ 2 + (Ay - By) ^ 2))
  81. End Function
  82.  
  83. Sub Make3D (AForm As Form, ctl As Control, ByVal BorderStyle As Integer, ByVal BorderWidth As Integer)
  84. '----------------------------------------------------------------------
  85. ' Wrap a 3D effect around a control on a form.
  86. '----------------------------------------------------------------------
  87. ' Color Constants
  88. Const DARK_GRAY = &H808080
  89. Const WHITE = &HFFFFFF
  90. Const BLACK = &H0
  91.  
  92. Dim RightSide As Single
  93. Dim BW As Integer
  94. Dim LeftTopColor As Long, RightBottomColor As Long
  95. Dim i As Integer
  96. Dim SaveMode As Integer
  97.  
  98.     If Not ctl.Visible Then Exit Sub
  99.  
  100.     SaveMode = AForm.ScaleMode
  101.     AForm.ScaleMode = PIXELS
  102.  
  103.     Select Case BorderStyle
  104.     Case 0: ' Inset
  105.         LeftTopColor = DARK_GRAY
  106.         RightBottomColor = WHITE
  107.     Case 1: ' Raised
  108.         LeftTopColor = WHITE
  109.         RightBottomColor = DARK_GRAY
  110.     End Select
  111.  
  112.     ' Set the top shading line.
  113.     For BW = 1 To BorderWidth
  114.     ' Top
  115.     AForm.CurrentX = ctl.Left - BW
  116.     AForm.CurrentY = ctl.Top - BW
  117.     AForm.Line -(ctl.Left + ctl.Width + (BW - 1), ctl.Top - BW), LeftTopColor
  118.     ' Right
  119.     AForm.Line -(ctl.Left + ctl.Width + (BW - 1), ctl.Top + ctl.Height + (BW - 1)), RightBottomColor
  120.     ' Bottom
  121.     AForm.Line -(ctl.Left - BW, ctl.Top + ctl.Height + (BW - 1)), RightBottomColor
  122.     ' Left
  123.     AForm.Line -(ctl.Left - BW, ctl.Top - BW), LeftTopColor
  124.     Next
  125.  
  126.     AForm.ScaleMode = SaveMode
  127. End Sub
  128.  
  129. Sub Paint3D (AForm As Form)
  130. '----------------------------------------------------------------------
  131. ' Put a 3D border around any control tagged "/3D_INSET/" or "/3D_RAISED/.
  132. '----------------------------------------------------------------------
  133. Dim i As Integer
  134.  
  135.     For i = 0 To AForm.Controls.Count - 1
  136.     If InStr(UCase$(AForm.Controls(i).Tag), "/3D_RAISED/") Then
  137.         Make3D AForm, AForm.Controls(i), BORDER_RAISED, 2
  138.     ElseIf InStr(UCase$(AForm.Controls(i).Tag), "/3D_INSET/") Then
  139.         Make3D AForm, AForm.Controls(i), BORDER_INSET, 2
  140.     End If
  141.     Next
  142. End Sub
  143.  
  144. Sub Pause (Seconds As Single)
  145. '------------------------------------------------------------
  146. ' Wait for a specified number of seconds.
  147. '------------------------------------------------------------
  148. Dim EndTime As Single
  149.  
  150.     EndTime = Timer + Seconds
  151.     While Timer < EndTime
  152.     DoEvents
  153.     Wend
  154. End Sub
  155.  
  156. Function PopField (AStr As String, ByVal FS As String) As String
  157. '------------------------------------------------------------
  158. ' Returns a substring of AStr.  if FS is in AStr, PopField
  159. ' returns the beginning of AStr, up to (but not including)
  160. ' FS.  AStr is also chopped so that it begins at the first
  161. ' character beyond FS.
  162. '
  163. ' If FS is not in AStr, PopField returns the contents of AStr
  164. ' and sets AStr to a null string ("").
  165. '
  166. ' PopField is usually used to parse a text file or text line.
  167. '------------------------------------------------------------
  168. Dim pos As Integer
  169.  
  170.     ' Look for the field separator.
  171.     pos = InStr(AStr, FS)
  172.  
  173.     ' Found the field separator.
  174.     If pos > 1 Then
  175.     PopField = Left$(AStr, pos - 1)
  176.     AStr = Mid$(AStr, pos + 1)
  177.  
  178.     ' Field separator is at beginning of AStr.
  179.     ElseIf pos = 1 Then
  180.     PopField = ""
  181.     If Len(AStr) > 1 Then
  182.         AStr = Mid$(AStr, pos + 1)
  183.     Else
  184.         AStr = ""
  185.     End If
  186.  
  187.     ' Field separator not in AStr.
  188.     Else
  189.     PopField = AStr
  190.     AStr = ""
  191.     End If
  192. End Function
  193.  
  194.